perm filename WEAVE.PAS[WEB,ALS]1 blob
sn#621851 filedate 1981-11-12 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00012 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 {2}
C00007 00003 {16}
C00019 00004 {51}
C00028 00005 {67}
C00037 00006 {89}
C00049 00007 {111}
C00054 00008 {149}
C00080 00009 {151}{159}
C00105 00010 {160}
C00121 00011 {185}
C00129 00012 {213}
C00159 ENDMK
C⊗;
{2}
{4}
{$C-,A+,D-}
{[$C+,D+]}
PROGRAM Weave(input,output,tty);
LABEL 9999;
CONST{7}maxbytes=20000;
maxnames=2000;
hashsize=353;
bufsize=100;
longestname=300;
longbufsize=400;
linelength=80;
maxrefs=12000;
maxtoks=20000;
maxtexts=2000;
maxscraps=1000;
stacksize=200;
TYPE{12}asciicode=0..127;
{22}
eightbits=0..255;
sixteenbits=0..65535;
{24}
namepointer=0..maxnames;
{34}
textpointer=0..maxtexts;
{163}
mode=(inner,outer);
outputstate=RECORD
endfield:sixteenbits;
tokfield:sixteenbits;
modefield:mode;
END;
VAR
{13}
buffer:ARRAY[0..longbufsize]OF asciicode;
{15}
phaseone:boolean;
{23}
bytemem:PACKED ARRAY[0..maxbytes]OF asciicode;
bytestart:ARRAY[0..maxnames]OF sixteenbits;
link:ARRAY[0..maxnames]OF sixteenbits;
ilk:ARRAY[0..maxnames]OF sixteenbits;
xref:ARRAY[0..maxnames]OF sixteenbits;
{25}
nameptr:namepointer;
byteptr:0..maxbytes;
{30}
xmem:ARRAY[0..maxrefs]OF PACKED RECORD
numfield:sixteenbits;
xlinkfield:sixteenbits;
END;
xrefptr:0..maxrefs;
modulecount:0..10239;
xrefswitch,modxrefswitc:0..10240;
{35}
tokmem:PACKED ARRAY[0..maxtoks]OF sixteenbits;
tokstart:ARRAY[textpointer]OF sixteenbits;
textptr:textpointer;
tokptr:0..maxtoks;
maxtokptr,
maxtxtptr:0..maxtoks;
{37}
idfirst:0..longbufsize;
idloc:0..longbufsize;
hash:ARRAY[0..hashsize]OF sixteenbits;
{45}
curname:namepointer;
{47}
module:ARRAY[0..longestname]OF asciicode;
{53}
page:sixteenbits;
line:sixteenbits;
limit:0..longbufsize;
loc:0..longbufsize;
inputhasende:boolean;
{56}
omitpage:boolean;
{66}
curmodule:namepointer;
{78}
nextcontrol:eightbits;
{84}
lhs,rhs:namepointer;
{88}
curxref:0..maxrefs;
{91}
outbuf:ARRAY[0..linelength]OF asciicode;
outptr:0..linelength;
outpage,outline:sixteenbits;
{100}
dig:ARRAY[0..4]OF 0..9;
{115}
cat:ARRAY[0..maxscraps]OF eightbits;
trans:ARRAY[0..maxscraps]OF textpointer;
pp:0..maxscraps;
scrapbase:0..maxscraps;
scrapptr:0..maxscraps;
loptr:0..maxscraps;
hiptr:0..maxscraps;
maxscrptr:0..maxscraps;
{147}
{TRACING:BOOLEAN;}
{164}
curstate:outputstate;
stack:ARRAY[1..stacksize]OF outputstate;
stackptr:0..stacksize;
maxstackptr:0..stacksize;
{180}
saveline,saveplace:sixteenbits;
{188}
thismodule:namepointer;
{197}
bucket:ARRAY[asciicode]OF namepointer;
nextname:namepointer;
c:asciicode;
h:0..hashsize;
{199}
curdepth:eightbits;
curbyte:0..maxbytes;
curval:sixteenbits;
maxsortptr:0..maxscraps;
{201}
collate:ARRAY[0..101]OF asciicode;
{209}
nextxref,thisxref:0..maxrefs;
{211}
{TROUBLESHOOT:BOOLEAN;
DDT:SIXTEENBITS;
DD:SIXTEENBITS;
DEBUGCYCLE:INTEGER;
DEBUGSKIPPED:INTEGER;}
{16}
{PROCEDURE DEBUGHELP;
FORWARD;}
{17}
PROCEDURE Error;
VAR k,l:0..longbufsize;
BEGIN
{18}
BEGIN
Writeln(tty,'. (p.',page:0,',l.',line:0,')');
IF loc>=limit THEN l:=limit
ELSE l:=loc;
FOR k:=1 TO l DO
IF buffer[k-1]=9 THEN Write(tty,' ')
ELSE Write(tty,Chr(buffer[k-1]));
Writeln(tty,'');
FOR k:=1 TO l DO Write(tty,' ');
FOR k:=l+1 TO limit DO Write(tty,Chr(buffer[k-1]));
Write(tty,' ');
END;
{DEBUGSKIPPED:=DEBUGCYCLE;
DEBUGHELP;}
END;
{19}
PROCEDURE Quit;
BEGIN
GOTO 9999;
END;
PROCEDURE Initialize;
VAR{38}
h:0..hashsize;
BEGIN
{26}
nameptr:=1;
byteptr:=1;
bytestart[0]:=1;
bytestart[1]:=1;
{28}
ilk[0]:=0;
{31}
xrefptr:=0;
xrefswitch:=0;
modxrefswitc:=0;
xmem[0].numfield:=0;
{36}
tokptr:=1;
textptr:=1;
tokstart[0]:=1;
tokstart[1]:=1;
maxtokptr:=1;
maxtxtptr:=1;
{39}
FOR h:=0 TO hashsize-1 DO hash[h]:=0;
{57}
omitpage:=false;
{73}
module[0]:=32;
{94}
outptr:=1;
outpage:=1;
outline:=1;
outbuf[1]:=114;
Write('\input webhd');
{97}
outbuf[0]:=92;
{116}
scrapbase:=1;
scrapptr:=0;
maxscrptr:=0;
{165}
maxstackptr:=0;
{200}
maxsortptr:=0;
{202}
collate[0]:=0;
collate[1]:=32;
FOR c:=1 TO 31 DO collate[c+1]:=c;
FOR c:=33 TO 47 DO collate[c]:=c;
FOR c:=58 TO 64 DO collate[c-10]:=c;
FOR c:=91 TO 96 DO collate[c-36]:=c;
FOR c:=123 TO 126 DO collate[c-62]:=c;
collate[65]:=24;
FOR c:=97 TO 122 DO collate[c-31]:=c;
FOR c:=48 TO 57 DO collate[c+44]:=c;
{212}
{TROUBLESHOOT:=TRUE;
DEBUGCYCLE:=1;
DEBUGSKIPPED:=0;
TRACING:=FALSE;
TROUBLESHOOT:=FALSE;
DEBUGCYCLE:=99999;}
END;
{11}
FUNCTION Openinput:boolean;
BEGIN
Reset(input,'','/E/I/O');
Openinput:=Eof(input);
END;
{14}
FUNCTION Inputln:boolean;
BEGIN
Readln;
IF Eof(input)THEN Inputln:=false
ELSE
BEGIN
limit:=0;
buffer[0]:=Ord(input↑);
IF buffer[0]<>12 THEN
WHILE buffer[limit]<>13 DO IF limit=bufsize-1 THEN
BEGIN
buffer[limit]:=13;
BEGIN
Writeln(tty);
Write(tty,'! Input line too long');
END;
Error;
END
ELSE
BEGIN
limit:=limit+1;
Get(
input);
IF Eof(input)THEN buffer[limit]:=13
ELSE buffer[limit]:=Ord(input↑);
END;
Inputln:=true;
END;
END;
{29}
PROCEDURE Printid(p:namepointer);
VAR k:0..maxbytes;
BEGIN
IF p>=nameptr THEN Write(tty,'IMPOSSIBLE')
ELSE FOR k:=bytestart[p]TO bytestart[p+1]-1 DO Write(tty,Chr(bytemem[k]));
END;
{32}
PROCEDURE Newxref(p:namepointer);
LABEL 10;
VAR
q:0..maxrefs;
m,n:sixteenbits;
BEGIN
IF((ilk[p]>2)OR(bytestart[p]+1=bytestart[p+1]))
AND(xrefswitch=0)THEN GOTO 10;
m:=modulecount+xrefswitch;
xrefswitch:=0;
q:=xref[p];
IF q>0 THEN
BEGIN
n:=xmem[q].numfield;
IF(n=m)OR(n=m+10240)THEN GOTO 10
ELSE IF m=n+10240 THEN
BEGIN
xmem[q].numfield:=m;
GOTO 10;
END;
END;
IF xrefptr=maxrefs THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','cross reference',' capacity exceeded');
END;
Error;
Quit;
END
ELSE
BEGIN
xrefptr:=xrefptr+1;
xmem[xrefptr].numfield:=m;
END;
xmem[xrefptr].linkfield:=q;
xref[p]:=xrefptr;
10:END;
{33}
PROCEDURE Newmodxref(p:
namepointer);
VAR q,r:0..maxrefs;
BEGIN
q:=xref[p];
r:=0;
IF q>0 THEN
BEGIN
IF modxrefswitc=0 THEN WHILE xmem[q].numfield>=10240 DO
BEGIN
r:=q;
q:=xmem[q].xlinkfield;
END
ELSE IF xmem[q].numfield>=10240 THEN
BEGIN
r:=q;
q:=xmem[q].xlinkfield;
END;
END;
IF xrefptr=maxrefs THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','cross reference',' capacity exceeded');
END;
Error;
Quit;
END
ELSE
BEGIN
xrefptr:=xrefptr+1;
xmem[xrefptr].numfield:=modulecount+modxrefswitc;
END;
xmem[xrefptr].xlinkfield:=q;
modxrefswitc:=0;
IF r=0 THEN xref[p]:=xrefptr
ELSE xmem[r].xlinkfield:=xrefptr;
END;
{40}
FUNCTION Idlookup(t:eightbits):namepointer;
LABEL 31,32;
VAR
i:0..longbufsize;
h:0..hashsize;
k:0..maxbytes;
l:0..longbufsize;
p,q:namepointer;
BEGIN
l:=idloc-idfirst;
{41}
h:=buffer[idfirst];
i:=idfirst+1;
WHILE i<idloc DO
BEGIN
h:=(h+h+buffer[i])MOD hashsize;
i:=i+1;
END;
{42}
p:=hash[h];
WHILE p<>0 DO
BEGIN
IF(bytestart[p+1]-bytestart[p]=l)AND((ilk[p]=t)
OR((t=0)AND(ilk[p]>2)))THEN
{43}
BEGIN
i:=idfirst;
k:=bytestart[p];
WHILE(i<idloc)AND(buffer[i]=bytemem[k])DO
BEGIN
i:=i+1;
k:=k+1;
END;
IF i=idloc THEN GOTO 31;
END;
p:=link[p];
END;
p:=nameptr;
link[p]:=hash[h];
hash[h]:=p;
31:;
IF p=nameptr THEN
{44}
BEGIN
IF byteptr+l>maxbytes THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','byte memory',' capacity exceeded');
END;
Error;
Quit;
END;
IF nameptr=maxnames THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','name',' capacity exceeded');
END;
Error;
Quit;
END;
i:=idfirst;
k:=byteptr;
WHILE i<idloc DO
BEGIN
bytemem[k]:=buffer[i];
k:=k+1;
i:=i+1;
END;
byteptr:=k;
nameptr:=nameptr+1;
bytestart[nameptr]:=k;
ilk[p]:=t;
xref[p]:=0;
END;
Idlookup:=p;
END;
{48}
FUNCTION Modlookup(l:sixteenbits):namepointer;
LABEL 31;
VAR
c:(less,equal,greater,prefix,extension);
j:0..longestname;
k:0..maxbytes;
p:namepointer;
q:namepointer;
BEGIN
c:=greater;
q:=0;
p:=ilk[0];
WHILE p<>0 DO
BEGIN
{50}
BEGIN k:=bytestart[p];
c:=equal;
j:=1;
WHILE(k<bytestart[p+1])AND(j<=l)
AND(module[j]=bytemem[k])DO
BEGIN
k:=k+1;
j:=j+1;
END;
IF k=bytestart[p+1]THEN
IF j>l THEN c:=equal
ELSE c:=extension
ELSE
IF j>l THEN c:=prefix
ELSE IF module[j]<bytemem[k]THEN c:=less
ELSE c:=greater;
END;
q:=p;
IF c=less THEN p:=link[q]
ELSE IF c=greater THEN p:=ilk[q]
ELSE GOTO 31;
END;
{49}
IF byteptr+l>maxbytes THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','byte memory',' capacity exceeded');
END;
Error;
Quit;
END;
IF nameptr=maxnames THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','name',' capacity exceeded');
END;
Error;
Quit;
END;
p:=nameptr;
IF c=less THEN link[q]:=p
ELSE ilk[q]:=p;
link[p]:=0;
ilk[p]:=0;
xref[p]:=0;
c:=equal;
FOR j:=1 TO l DO bytemem[byteptr+j-1]:=module[j];
byteptr:=byteptr+l;
nameptr:=nameptr+1;
bytestart[nameptr]:=byteptr;;
31:IF c<>equal THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Incompatible module names');
END;
Error;
END;
END;
p:=0;
END;
Modlookup:=p;
END;
{51}
FUNCTION Prefixlookup(l:sixteenbits):namepointer;
LABEL 31;
VAR
c:(less,equal,greater,prefix,extension);
count:0..maxnames;
j:0..longestname;
k:0..maxbytes;
p:namepointer;
q:namepointer;
r:namepointer;
BEGIN
q:=0;
p:=ilk[0];
count:=0;
r:=0;
WHILE p<>0 DO
BEGIN
{50}
BEGIN
k:=bytestart[p];
c:=equal;
j:=1;
WHILE(k<bytestart[p+1])AND(j<=l)AND(module[j]=bytemem[k])DO
BEGIN
k:=k+1;
j:=j+1;
END;
IF k=bytestart[p+1]THEN
IF j>l THEN c:=equal
ELSE c:=extension
ELSE IF j>l THEN c:=prefix
ELSE IF module[j]<bytemem[k]THEN c:=less
ELSE c:=greater;
END;
IF c=less THEN p:=link[p]
ELSE IF c=greater THEN p:=ilk[p]
ELSE
BEGIN
r:=p;
count:=count+1;
q:=ilk[p];
p:=link[p];
END;
IF p=0 THEN
BEGIN
p:=q;
q:=0;
END;
END;
IF count<>1 THEN
IF count=0 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Name does not match');
END;
Error;
END;
END
ELSE
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Ambiguous prefix');
END;
Error;
END;
END;
Prefixlookup:=r;
END;
{54}
PROCEDURE Resetinput;
BEGIN
IF Openinput
THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Couldn''t open the input file.');
END;
Quit;
END;
page:=0;
line:=0;
limit:=0;
loc:=1;
buffer[0]:=32;
inputhasende:=false;
END;
{55}
PROCEDURE Getline;
BEGIN
IF buffer[0]=12 THEN line:=0;
IF Inputln THEN
BEGIN
IF line=0 THEN
BEGIN
page:=page+1;
Write(tty,page:0,' ');
{58}
IF(page=1)AND(limit=29)THEN
IF(buffer[0]=67)AND(buffer[8]=22)THEN
BEGIN
REPEAT
IF Inputln THEN
ELSE
BEGIN
limit:=0;
buffer[0]:=12;
END;
UNTIL buffer[0]=12;
omitpage:=true;
END;
END;
IF buffer[limit]=13 THEN buffer[limit]:=32;
END
ELSE IF buffer[0]<>12
THEN
BEGIN
limit:=0;
buffer[0]:=12;
END
ELSE inputhasende:=true;
line:=line+1;
loc:=0;
END;
{60}
FUNCTION Controlcode(c:asciicode):eightbits;
BEGIN
CASE c OF
64:Controlcode:=64;
39:Controlcode:=12;
32,9,42:Controlcode:=144;
68,100:Controlcode:=140;
70,102:Controlcode:=139;
123:Controlcode:=9;
126:Controlcode:=10;
80,112:Controlcode:=141;
38:Controlcode:=127;
60:Controlcode:=142;
62:
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln
(tty);Write(tty,'! Extra @>');
END;
Error;
END;
END;
Controlcode:=0;
END;
84,116:Controlcode:=133;
33:Controlcode:=126;
63:Controlcode:=125;
94:Controlcode:=131;
46:Controlcode:=132;
44:Controlcode:=134;
47:Controlcode:=135;
35:Controlcode:=136;
43:Controlcode:=137;
59:Controlcode:=138;
{61}
{48:
BEGIN
TRACING:=FALSE;
CONTROLCODE:=0;
END;
49:
BEGIN
TRACING:=TRUE;
CONTROLCODE:=0;
END;};
OTHERS:
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Unknown control code');
END;
Error;
END;
END;
Controlcode:=0;
END
END;
END;
{62}
PROCEDURE Skiplimbo;
LABEL 10;
VAR c:
asciicode;
BEGIN
WHILE true DO IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
IF inputhasende THEN GOTO 10
ELSE loc:=1;
END
ELSE
BEGIN
buffer[limit+1]:=64;
WHILE buffer[loc]<>64 DO loc:=loc+1;
IF loc<=limit
THEN BEGIN loc:=loc+2;
c:=buffer[loc-1];
IF(c=32)OR(c=9)OR(c=42)THEN GOTO 10;
END;
END;
10:END;
{63}
FUNCTION Skiptex:eightbits;
LABEL 30;
VAR
c:eightbits;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
loc:=1;
c:=143;
GOTO 30;
END;
END;
buffer[limit+1]:=64;
REPEAT c:=buffer[loc];
loc:=loc+1;
IF c=124 THEN GOTO 30;
UNTIL c=64;
IF loc<=limit THEN
BEGIN
c:=Controlcode(buffer[loc]);
loc:=loc+1;
GOTO 30;
END;
END;
30:Skiptex:=c;
END;
{64}
FUNCTION Skipcomment(bal:eightbits):eightbits;
LABEL 30;
VAR c:asciicode;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN Getline;
IF buffer[0]=12 THEN
BEGIN
loc:=1;
bal:=0;
GOTO 30;
END;
END;
c:=buffer[loc];
loc:=loc+1;
IF c=124 THEN GOTO 30;
{65}
IF c=64 THEN
BEGIN
c:=buffer[loc];
IF(c<>32)AND(c<>9)AND(c<>42)THEN loc:=loc+1
ELSE
BEGIN
loc:=loc-1;
bal:=0;
GOTO 30;
END
END
ELSE IF(c=92)AND(buffer[loc]<>64)THEN loc:=loc+1
ELSE IF c=123 THEN bal:=bal+1
ELSE IF c=126 THEN
BEGIN
bal:=bal-1;
IF bal=0 THEN GOTO 30;
END;
END;
30:Skipcomment:=bal;
END;
{67}
FUNCTION
Getnext:eightbits;
LABEL 20,30;
VAR
c:eightbits;
d:eightbits;
j,k:0..longestname;
BEGIN
20:IF loc>limit THEN Getline;
c:=buffer[loc];
loc:=loc+1;
CASE c OF
65,66,67,68,69,70,71,72,73,74,75,76,77,
78,79,80,81,82,83,84,85,86,87,88,89,90,
97,98,99,100,101,102,103,104,105,106,
107,108,109,110,111,112,113,114,115,
116,117,118,119,120,121,122:
{69}
BEGIN
IF((c=69)OR(c=101))AND(loc>0)THEN
IF(buffer[loc-1]<=57)AND(buffer[loc-1]>=48)THEN
c:=128;
IF c<>128 THEN
BEGIN
loc:=loc-1;
idfirst:=loc;
REPEAT loc:=loc+1;
d:=buffer[loc];
UNTIL((d<48)OR((d>57)AND(d<65))
OR((d>90)AND(d<97))OR(d>122))AND(d<>24);
c:=130;
idloc:=loc;
END;
END;
39,34:
{70}
BEGIN
idfirst:=loc-1;
REPEAT
d:=buffer[loc];
loc:=loc+1;
IF loc>limit THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);Write(tty,'! String constant didn''t end');
END;
Error;
END;
END;
loc:=limit;
d:=c;
END;
UNTIL d=c;
idloc:=loc;
c:=129;
END;
64:
{71}
BEGIN
c:=Controlcode(buffer[loc]);
loc:=loc+1;
IF c=126 THEN
BEGIN
xrefswitch:=10240;
GOTO 20;
END
ELSE IF c=125 THEN
BEGIN
xrefswitch:=0;
GOTO 20;
END
ELSE IF(c<=133)AND(c>=131)THEN
{77}
BEGIN
idfirst:=loc;
buffer[limit+1]:=64;
WHILE buffer[loc]<>64 DO loc:=loc+1;
idloc:=loc;
IF loc>limit THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Control text didn''t end');
END;
Error;
END;
END;
loc:=limit;
END
ELSE
BEGIN
loc:=loc+2;
IF buffer[loc-1]<>62 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Control codes are forbidden in control text');
END;
Error;
END;
END;
END;
END
ELSE IF c=142 THEN
{72}
BEGIN
{74}
k:=0;WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Page ended in module name');
END;
Error;
END;
END;
loc:=1;
GOTO 30;
END;
END;
d:=buffer[loc];
{75}
IF d=64 THEN
BEGIN d:=buffer[loc+1];
IF d=62 THEN
BEGIN
loc:=loc+2;
GOTO 30;
END;
IF(d=32)OR(d=9)OR(d=42)THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Module name didn''t end');
END;
Error;
END;
END;
GOTO 30;
END;
k:=k+1;
module[k]:=64;
loc:=loc+1;
END;
loc:=loc+1;
IF k<longestname-1 THEN k:=k+1;
IF(d=32)OR(d=9)THEN
BEGIN
d:=32;
IF module[k-1]=32 THEN k:=k-1;
END;
module[k]:=d;
END;
30:
{76}
IF k>=longestname-2 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Module name too long: ');
END;
FOR j:=1 TO 25 DO Write(tty,Chr(module[j]));
Write(tty,'...');
END;
IF(module[k]=32)AND(k>0)THEN k:=k-1;
;
IF k>3 THEN
BEGIN
IF(module[k]=46)AND(module[k-1]=46)
AND(module[k-2]=46)THEN curmodule:=Prefixlookup(k-3)
ELSE curmodule:=Modlookup(k);
END
ELSE curmodule:=Modlookup(k);
END;
END;
{68}
46: IF buffer[loc]=46 THEN
BEGIN
c:=32;
loc:=loc+1;
END;
58:IF buffer[loc]=61 THEN
BEGIN
c:=95;
loc:=loc+1;
END;
61:IF buffer[loc]=61 THEN
BEGIN
c:=30;
loc:=loc+1;
END;
62:IF buffer[loc]=61 THEN
BEGIN
c:=29;
loc:=loc+1;
END;
60:
IF buffer[loc]=61 THEN
BEGIN
c:=28;
loc:=loc+1;
END
ELSE IF buffer[loc]=62 THEN
BEGIN
c:=27;
loc:=loc+1;
END;
40:IF buffer[loc]=42 THEN
BEGIN
c:=9;loc:=loc+1;
END;
42:IF buffer[loc]=41 THEN
BEGIN
c:=10;
loc:=loc+1;
END;
32,9:GOTO 20;
12:c:=143;
OTHERS:
END;
{IF TROUBLESHOOT THEN DEBUGHELP;}
Getnext:=c;
END;
{81}
PROCEDURE Pascalxref;
LABEL 10;
VAR p:namepointer;
BEGIN
WHILE
nextcontrol<139 DO
BEGIN IF(nextcontrol>=130)AND(nextcontrol<=132)THEN
BEGIN
p:=Idlookup(nextcontrol-130);
Newxref(p);
IF(ilk[p]=16)OR(ilk[p]=21) THEN xrefswitch:=10240;
END;
nextcontrol:=Getnext;
IF(nextcontrol=124)OR(nextcontrol=123)THEN GOTO 10;
END;
10:END;
{82}
PROCEDURE Outerxref;
VAR bal:eightbits;
BEGIN WHILE nextcontrol<139 DO
IF nextcontrol<>123 THEN Pascalxref
ELSE
BEGIN
bal:=Skipcomment(1);
nextcontrol:=124;
WHILE bal>0 DO
BEGIN
Pascalxref;
IF nextcontrol=124 THEN bal:=Skipcomment(bal)
ELSE bal:=0;
END;
END;
END;
{89}
PROCEDURE Modcheck(p:namepointer);
BEGIN
IF p>0THEN
BEGIN
Modcheck(link[p]);
curxref:=xref[p];
IF xmem[curxref].numfield<10240 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Never defined: <');
END;
Printid(p);
Write(tty,'>');
END;
WHILE xmem[curxref].numfield>=10240 DO
curxref:=xmem[curxref].xlinkfield;
IF curxref=0 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Never used: <');
END;
Printid(p);
Write(tty,'>');
END;
Modcheck(ilk[p]);
END;
END;
{92}
PROCEDURE Flushbuffer(b:eightbits);
VAR
k:0..linelength;
BEGIN
IF outbuf[b]=32 THEN b:=b-1;
IF(b>0)OR(outline>1)THEN
BEGIN
FOR k:=1 TO b DO Write(Chr(outbuf[k]));
Writeln('');
outline:=outline+1;
END;
IF b<outptr THEN IF outbuf[b+1]=32 THEN b:=b+1;
IF b<outptr THEN FOR k:=b+1 TO outptr DO outbuf[k-b]:=outbuf[k];
outptr:=outptr-b;
END;
{95}
PROCEDURE Writeendofpa;
BEGIN IF outptr>0 THEN Flushbuffer(outptr);
IF omitpage THEN omitpage:=false
ELSE
BEGIN
Write(Chr(12));
outpage:=outpage+1;
outline:=1;
END;
END;
{98}
PROCEDURE Breakout;
LABEL 31;
VAR k:0..linelength;
c,d:asciicode;
BEGIN k:=outptr;
d:=outbuf[k];
WHILE d<>32 DO
BEGIN
k:=k-1;
c:=outbuf[k];
IF c=92 THEN
IF k=0 THEN
{99}
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Line had to be broken (output p.',outpage:0,',l.',outline:0);
END;
Writeln(tty,'):');
FOR k:=1 TO outptr DO Write(tty,Chr(outbuf[k]));
Writeln(tty,'');
k:=outptr;
c:=32;
END
ELSE IF(((d<65)OR((d>90)AND(d<97))
OR(d>122))AND(outbuf[k-1]<>92))THEN
BEGIN
k:=k+1;
c:=32;
END;
d:=c;
END;
Flushbuffer(k);
END;
{101}
PROCEDURE Outval(v:sixteenbits);
VAR k:0..5;
BEGIN
k:=0;
REPEAT
dig[k]:=v MOD 10;
v:=v DIV 10;
k:=k+1;
UNTIL v=0;
REPEAT
k:=k-1;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=dig[k]+48;
END;
UNTIL k=0;
END;
{102}
PROCEDURE Outname(p:namepointer);
VAR k:0..maxbytes;
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=123;
END;
FOR k:=bytestart[curname]TO bytestart[curname+1]-1 DO
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=bytemem[k];
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=126;
END;
END;
{103}
PROCEDURE Copylimbo;
LABEL 10;
VAR c:asciicode;
BEGIN
WHILE true DO
IF loc>limit THEN
BEGIN
BEGIN
IF(outptr>0)OR(limit=0)THEN Flushbuffer(outptr);
END;
Getline;
IF buffer[0]=12 THEN
BEGIN
IF inputhasende THEN GOTO 10;
Writeendofpa;
loc:=1;
END;
END
ELSE
BEGIN
buffer[limit+1]:=64;
{104}
WHILE buffer[loc]<>64 DO
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=buffer[loc];
END;
loc:=loc+1;
END;
IF loc<=limit THEN
BEGIN
loc:=loc+2;
c:=buffer[loc-1];
IF(c=32)OR(c=9)OR(c=42)THEN GOTO 10;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=64;
END;
IF c<>64 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Double @ required outside of modules');
END;
Error;
END;
END;
END;
END;
10:
END;
{105}
FUNCTION Copytex:eightbits;
LABEL 30;
VAR c:eightbits;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
BEGIN
IF(outptr>0)OR(limit=0)THEN Flushbuffer(outptr);
END;
Getline;
IF buffer[0]=12 THEN
BEGIN
loc:=1;
c:=143;
GOTO 30;
END;
END;
buffer[limit+1]:=64;
{106}
REPEAT
c:=buffer[loc];
loc:=loc+1;
IF c=124 THEN GOTO 30;
IF c<>64 THEN
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=c;
END;
IF(outptr=1)AND((c=32)OR(c=9))THEN outptr:=outptr-1;
END;
UNTIL c=64;
IF loc<=limit THEN
BEGIN
c:=Controlcode(buffer[loc]);
loc:=loc+1;
IF c=64 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=64;
END;
GOTO 30;
END;
END;
30:Copytex:=c;
END;
{107}
FUNCTION Copycomment(bal:eightbits):eightbits;
LABEL 30;
VAR c:asciicode;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Page ended in mid_comment');
END;
Error;
END;
END;
loc:=1;
{109}
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
END;
Error;
Quit;
END;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
END;
REPEAT
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
END;
Error;
Quit;
END;
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
END;
bal:=bal-1;
UNTIL bal=0;
GOTO 30;
;
END;
END;
c:=buffer[loc];
loc:=loc+1;
IF c=124 THEN GOTO 30;
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
END;
Error;
Quit;
END;
tokmem[tokptr]:=c;
tokptr:=tokptr+1;
END;
{108}
IF c=64 THEN
BEGIN
loc:=loc+1;
ifbuffer[loc-1]<>64 THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Illegal use of @ in comment');
END;
Error;
END;
END;
loc:=loc-2;
tokptr:=tokptr-1;
{109}
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
END;
Error;
Quit;
END;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
END;
REPEAT
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
BEGIN Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
END;
Error;
Quit;
END;
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
END;
bal:=bal-1;
UNTIL bal=0;
GOTO 30;
;
END;
END
ELSE IF(c=92)AND(buffer[loc]<>64)THEN
BEGIN
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
END;
Error;
Quit;
END;
tokmem[tokptr]:=buffer[loc];
tokptr:=tokptr+1;
END;
loc:=loc+1;
END
ELSE IF c=123 THEN bal:=bal+1
ELSE IF c=126 THEN
BEGIN
bal:=bal-1;
IF bal=0 THEN GOTO 30;
END;
END;
30:Copycomment:=bal;
END;
{111}
{PROCEDURE PRINTCAT(C:EIGHTBITS);
BEGIN
CASE C OF
1:WRITE(TTY,'simp');
2:WRITE(TTY,'math');
3:WRITE(TTY,'intro');
4:WRITE(TTY,'open');
5:WRITE(TTY,'beginning');
6:WRITE(TTY,'close');
7:WRITE(TTY,'alpha');
8:WRITE(TTY,'omega');
9:WRITE(TTY,'semi');
10:WRITE(TTY,'terminator');
11:WRITE(TTY,'stmt');
12:WRITE(TTY,'cond');
13:WRITE(TTY,'clause');
14:WRITE(TTY,'colon');
15:WRITE(TTY,'exp');
16:WRITE(TTY,'proc');
17:WRITE(TTY,'casehead');
18:WRITE(TTY,'recordhead');
19:WRITE(TTY,'varhead');
20:WRITE(TTY,'elsie');
21:WRITE(TTY,'casey');
22:WRITE(TTY,'module');
OTHERS:WRITE(TTY,'UNKNOWN')
END;
END;}
{117}
PROCEDURE PRINTTEXT(P:TEXTPOINTER);
VAR J:0..MAXTOKS;
R:0..10239;
BEGIN
IF P>=TEXTPTR THEN
WRITE(TTY,'BAD')
ELSE FOR J:=TOKSTART[P]TO TOKSTART[P+1]-1 DO
BEGIN
R:=TOKMEM[J]MOD 10240;
CASE TOKMEM[J]DIV 10240 OF
1:
BEGIN
WRITE(TTY,'\\',CHR(123));
PRINTID(R);
WRITE(TTY,CHR(126));
END;
2:
BEGIN
WRITE(TTY,'\&',CHR(123));
PRINTID(R);
WRITE(TTY,CHR(126));
END;
3:
BEGIN
WRITE(TTY,'<');
PRINTID(R);
WRITE(TTY,'>');
END;
4:WRITE(TTY,'[[',R:0,']]');
5:WRITE(TTY,'|[[',R:0,']]|');
OTHERS:
[118]
CASE R OF
131:WRITE(TTY,'\mathbin',CHR(123));
132:WRITE(TTY,'\mathrel',CHR(123));
133:WRITE(TTY,'\mathop',CHR(123));
134:WRITE(TTY,'[ccancel]');
135:WRITE(TTY,'[cancel]');
136:WRITE(TTY,'[indent]');
137:WRITE(TTY,'[outdent]');
139:WRITE(TTY,'[backup]');
138:WRITE(TTY,'[opt]');
140:WRITE(TTY,'[break]');
141:WRITE(TTY,'[force]');
142:WRITE(TTY,'[fforce]');
143:WRITE(TTY,'[quit]');
OTHERS:WRITE(TTY,CHR(R))
END
END;
END;
END;
{142}
PROCEDURE Red(j:sixteenbits; k:eightbits;c:eightbits;d:integer);
VAR i:0..maxscraps;
BEGIN
cat[j]:=c;trans[j]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
IF k>1 THEN
BEGIN
FOR i:=j+k TO loptr DO
BEGIN
cat[i-k+1]:=cat[i];
trans[i-k+1]:=trans[i];
END;
loptr:=loptr-k+1;
END;
{143}
IF pp+d>=scrapbase THEN pp:=pp+d
ELSE pp:=scrapbase;
END;
{144}
PROCEDURE Sq(j:sixteenbits;k:eightbits;c:eightbits;d:integer);
VAR i:0..maxscraps;
BEGIN
IF k=1 THEN
BEGIN
cat[j]:=c;
{143}
IF pp+d>=scrapbase THEN pp:=pp+d
ELSE pp:=scrapbase;
END
ELSE
BEGIN FOR i:=j TO j+k-1 DO
BEGIN
tokmem[tokptr]:=40960+trans[i];
tokptr:=tokptr+1;
END;
Red(j,k,c,d);
END;
END;
{148}
PROCEDURE PROD(N:EIGHTBITS);
VAR K:1..MAXSCRAPS;
BEGIN
IF TRACING THEN
BEGIN
BEGIN
WRITELN(TTY);
WRITE(TTY,N:0,':');
END;
FOR K:=SCRAPBASE TO LOPTR DO
BEGIN
IF K=PP THEN WRITE(TTY,'*')
ELSE WRITE(TTY,' ');
PRINTCAT(CAT[K]);
END;
IF HIPTR<=SCRAPPTR THEN WRITE(TTY,'...');
END;
END;
{149}
FUNCTION Translate:textpointer;
LABEL 30,31;
VAR
i:1..maxscraps;
k:0..longbufsize;
BEGIN
pp:=scrapbase;
loptr:=pp-1;
hiptr:=pp;
{150}
{IF TRACING THEN
BEGIN
BEGIN
WRITELN(TTY);
WRITE(TTY,'Tracing after p.',PAGE:0,',l.',LINE:0,':');
END;
IF LOC>50 THEN
BEGIN
WRITE(TTY,'...');
FOR K:=LOC-50 TO LOC DO WRITE(TTY,CHR(BUFFER[K-1]));
END
ELSE FOR K:=1 TO LOC DO WRITE(TTY,CHR(BUFFER[K-1]));
END};
{145}
WHILE true DO
BEGIN
{146}
IF loptr<pp+3 THEN
BEGIN
REPEAT
IF hiptr<=scrapptr THEN
BEGIN
loptr:=loptr+1;
cat[loptr]:=cat[hiptr];
trans[loptr]:=trans[hiptr];
hiptr:=hiptr+1;
END;
UNTIL(hiptr>scrapptr)OR(loptr=pp+3);
FOR i:=loptr+1 TO pp+3 DO cat[i]:=0;
END;
IF(tokptr+8>maxtoks)OR(textptr+4>maxtexts)THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
END;
Error;
Quit;
END;
IF pp>loptr THEN GOTO 30;
{120}
CASE cat[pp]OF
7:
{121}
IF cat[pp+1]=2 THEN
BEGIN
IF cat[pp+2]=14 THEN
BEGIN
Sq(pp+1,2,2,0);
{PROD(1)};
GOTO 31;
END
ELSE IF cat[pp+2]=8 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
BEGIN
Red(pp,3,13,-1);
{PROD(2)};
GOTO 31;
END;
END;
END
ELSE IF cat[pp+1]=8 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
BEGIN
Red(pp,2,13,-1);
{PROD(3)};
GOTO 31;
END;
END
ELSE IF cat[pp+1]=1 THEN
BEGIN
Sq(pp+1,1,2,0);
{PROD(4)};
GOTO 31;
END;
5:
{122}
IF cat[pp+1]=6 THEN
BEGIN
IF(cat[pp+2]=10)OR(cat[pp+2]=11)THEN
BEGIN
Sq(pp,3,11,-2);
{PROD(5)};
GOTO 31;
END;
END
ELSE IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
BEGIN
Red(pp,2,5,0);
{PROD(6)};
GOTO 31;
END;
END;
17:
{123}
IF cat[pp+1]=21 THEN
BEGIN
IF cat[pp+2]=13 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
BEGIN
Red(pp,3,17,0);
{PROD(7)};
GOTO 31;
END;
END;
END
ELSE
IF cat[pp+1]=6 THEN
BEGIN
IF cat[pp+2]=10 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
BEGIN
Red(pp,3,11,-2);
{PROD(8)};
GOTO 31;
END;
END;
END
ELSE IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
BEGIN
Red(pp,2,17,0);
{PROD(9)};
GOTO 31;
END;
END;
21:
{124}
IF cat[pp+1]=13 THEN
BEGIN
Sq(pp,2,17,0);
{PROD(10)};
GOTO 31;
END;
13:
{125}
IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
BEGIN
Red(pp,2,11,-2);
{PROD(11)};
GOTO 31;
END;
END;
12:
{126}
IF(cat[pp+1]=13)AND(cat[pp+2]=11)THEN
IF cat[pp+3]=20 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+3];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
BEGIN
Red(pp,4,13,-2);
{PROD(12)};
GOTO 31;
END;
END
ELSE
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
BEGIN
Red(pp,3,11,-2);
{PROD(13)};
GOTO 31;
END;
END;
20:
{127}
BEGIN
Sq(pp,1,3,-3);
{PROD(14)};
GOTO 31;
END;
15:
{128}
IF cat[pp+1]=2 THEN
BEGIN
IF cat[pp+2]=1 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
BEGIN
Red(pp,3,2,-1);
{PROD(15)};
GOTO 31;
END;
END;
END
ELSE IF cat[pp+1]=1 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
BEGIN
Red(pp,2,2,-1);
{PROD(16)};
GOTO 31;
END;
END;
3:
{129}
IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=138;
tokptr:=tokptr+1;
tokmem[tokptr]:=55;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
BEGIN
Red(pp,2,11,-2);
{PROD(17)};
GOTO 31;
END;
END;
2:
{130}
IF cat[pp+1]=14 THEN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
BEGIN
Red(pp,2,3,-3);
{PROD(18)};
GOTO 31;
END;
END
ELSE IF cat[pp+1]=2 THEN
BEGIN
Sq(pp,2,2,-1);
{PROD(19)};
GOTO 31;
END
ELSE IF cat[pp+1]=1 THEN
BEGIN
Sq(pp,2,2,-1);
{PROD(20)};
GOTO 31;
END
ELSE IF cat[pp+1]=10 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
BEGIN
Red(pp,2,11,-2);
{PROD(21)};
GOTO 31;
END;
END;
22:
{131}
IF(cat[pp+1]=10)OR(cat[pp+1]=9)THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
BEGIN
Red(pp,2,11,-2);
{PROD(22)};
GOTO 31;
END;
END
ELSE BEGIN Sq(pp,1,1,-2);
{PROD(23)};
GOTO 31;
END;
4:
{132}
IF cat[pp+1]=21 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
BEGIN
Red(pp,2,21,-2);
{PROD(24)};
GOTO 31;
END;
END
ELSE IF cat[pp+1]=6 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=44;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
BEGIN
Red(pp,2,2,-1);
{PROD(25)};
GOTO 31;
END;
END
ELSE IF cat[pp+1]=2 THEN
{133}
BEGIN
IF cat[pp+2]=21 THEN
BEGIN
Sq(pp,3,21,-2);
{PROD(26)};
GOTO 31;
END
ELSE IF cat[pp+2]=6 THEN
BEGIN
Sq(pp,3,2,-1);
{PROD(27)};
GOTO 31;
END
ELSE IF cat[pp+2]=14 THEN
BEGIN
Sq(pp+1,2,2,0);
{PROD(28)};
GOTO 31;
END
ELSE IF cat[pp+2]=16 THEN
BEGIN
IF cat[pp+3]=3 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=133;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
BEGIN
Red(pp+1,3,2,0);
{PROD(29)};
GOTO 31;
END;
END;
END
ELSE IF cat[pp+2]=9 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=44;
tokptr:=tokptr+1;
tokmem[tokptr]:=138;
tokptr:=tokptr+1;
tokmem[tokptr]:=53;
tokptr:=tokptr+1;
BEGIN
Red(pp+1,2,2,0);
{PROD(30)};
GOTO 31;
END;
END
ELSE IF cat[pp+2]=19 THEN
BEGIN
IF cat[pp+3]=3 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=133;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
BEGIN
Red(pp+1,3,2,0);
{PROD(31)};
GOTO 31;
END;
END;
END;
END
ELSE IF cat[pp+1]=16 THEN
BEGIN
IF cat[pp+2]=3 THEN
BEGIN
tokmem[tokptr]:=133;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
BEGIN
Red(pp+1,2,2,0);
{PROD(32)};
GOTO 31;
END;
END;
END
ELSE IF cat[pp+1]=1 THEN
BEGIN
Sq(pp+1,1,2,0);
{PROD(33)};
GOTO 31;
END
ELSE IF cat[pp+1]=19 THEN
BEGIN
IF cat[pp+2]=3 THEN
BEGIN
tokmem[tokptr]:=133;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
BEGIN
Red(pp+1,2,2,0);
{PROD(34)};
GOTO 31;
END;
END;
END;
16:
{134}
IF cat[pp+1]=5 THEN
BEGIN
IF(cat[pp+2]=6)AND (cat[pp+3]=10)THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+3];
tokptr:=tokptr+1;
BEGIN
Red(pp,4,11,-2);
{PROD(35)};
GOTO 31;
END;
END;
END
ELSE IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
BEGIN
Red(pp,2,16,-2);
{PROD(36)};
GOTO 31;
END;
END;
18:
{135}
IF(cat[pp+1]=3)AND(cat[pp+2]=21)THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
BEGIN
Red(pp,3,21,-2);
{PROD(37)};
GOTO 31;
END;
END
ELSE
BEGIN
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
BEGIN
Red(pp,1,17,0);
{PROD(38)};
GOTO 31;
END;
END;
9:
{136}
BEGIN
Sq(pp,1,10,-3);
{PROD(39)};
GOTO 31;
END;
1:
{137}
IF cat[pp+1]=14 THEN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
BEGIN
Red(pp,2,3,-3);
{PROD(40)};
GOTO 31;
END;
END
ELSE IF cat[pp+1]=2 THEN
BEGIN
Sq(pp,2,2,-1);
{PROD(41)};
GOTO 31;
END
ELSE IF cat[pp+1]=22 THEN
BEGIN
Sq(pp,2,22,0);
{PROD(42)};
GOTO 31;
END
ELSE IF cat[pp+1]=1 THEN
BEGIN
Sq(pp,2,1,-2);
{PROD(43)};
GOTO 31;
END
ELSE IF cat[pp+1]=10 THEN
BEGIN
Sq(pp,2,11,-2);
{PROD(44)};
GOTO 31;
END;
11:
{138}
IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
BEGIN
Red(pp,2,11,-2);
{PROD(45)};
GOTO 31;
END;
END;
10:
{139}
BEGIN
Sq(pp,1,11,-2);
{PROD(46)};
GOTO 31;
END;
19:
{140}
IF cat[pp+1]=5 THEN
BEGIN
Sq(pp,1,11,-2);
{PROD(47)};
GOTO 31;
END
ELSE IF cat[pp+1]=2 THEN
BEGIN
IF cat[pp+2]=14 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
BEGIN
Red(pp+1,2,3,+1);
{PROD(48)};
GOTO 31;
END;
END;
END
ELSE IF cat[pp+1]=1 THEN
BEGIN
IF cat[pp+2]=14 THEN
BEGIN
Sq(pp+1,2,3,+1);
{PROD(49)};
GOTO 31;
END;
END
ELSE IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
BEGIN
Red(pp,2,19,-2);
{PROD(50)};
GOTO 31;
END;
END;
OTHERS:
END;
pp:=pp+1;
31:
END;
30:;
IF(loptr=scrapbase)AND(cat[loptr]<>2)THEN
Translate:=trans[loptr]
ELSE
BEGIN
FOR pp:=scrapbase TO loptr DO
BEGIN
IF pp<>scrapbase THEN
BEGIN
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
END;
IF cat[pp]=2 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
END;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
IF cat[pp]=2 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
END;
IF tokptr+6>maxtoks THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
END;
Error;
Quit;
END;
END;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
Translate:=textptr-1;
END;
END;
{151}{159}
PROCEDURE Appcomment;
BEGIN
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
IF(scrapptr<scrapbase)OR(cat[scrapptr]<8)
OR(cat[scrapptr]>10)THEN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=10;
trans[scrapptr]:=0;
END
ELSE
BEGIN
tokmem[tokptr]:=40960+trans[scrapptr];
tokptr:=tokptr+1;
END;
tokmem[tokptr]:=textptr+40959;
tokptr:=tokptr+1;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
PROCEDURE Pascalparse;
LABEL 21,10;
VAR
j:0..longbufsize;
p:namepointer;
BEGIN
WHILE nextcontrol<139 DO
BEGIN
{153}
IF(scrapptr+4>maxscraps)OR(tokptr+6>maxtoks)
OR(textptr+4>maxtexts)THEN
BEGIN
BEGIN
Writeln(tty);Write(tty,'! Sorry, ','scrap',' capacity exceeded');
END;
Error;
Quit;
END;
21:CASE nextcontrol OF
6:
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=105;
tokptr:=tokptr+1;
tokmem[tokptr]:=110;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
32:
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=116;
tokptr:=tokptr+1;
tokmem[tokptr]:=111;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
129:
{154}
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=46;
tokptr:=tokptr+1;
tokmem[tokptr]:=123;
tokptr:=tokptr+1;
j:=idfirst;
WHILE j<idloc DO
BEGIN
CASE buffer[j] OF
32,92,35,37,36,94,39,
96,1,123,126,22,27,29,28:
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
END;
64:IF buffer[j+1]=64 THEN j:=j+1
ELSE
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Double @ should be used in strings');
END;
Error;
END;
END;
OTHERS:
END;
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
BEGIN
Writeln(tty);Write(tty,'! Sorry, ','token',' capacity exceeded');
END;
Error;
Quit;
END;
tokmem[tokptr]:=buffer[j];
tokptr:=tokptr+1;
END;
j:=j+1;
END;
BEGIN
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
END;
35,36,37,94:
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
0,124,131,132:;
40,91:
BEGIN
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=4;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
41,93:
BEGIN
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=6;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
42:
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=97;
tokptr:=tokptr+1;
tokmem[tokptr]:=115;
tokptr:=tokptr+1;
tokmem[tokptr]:=116;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
44:
BEGIN
tokmem[tokptr]:=44;
tokptr:=tokptr+1;
tokmem[tokptr]:=138;
tokptr:=tokptr+1;
tokmem[tokptr]:=57;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
46,48,49,50,51,52,
53,54,55,56,57:
BEGIN
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
59:
BEGIN
tokmem[tokptr]:=59;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=9;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
58:
BEGIN
tokmem[tokptr]:=58;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=14;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
130:
{156}
BEGIN
p:=Idlookup(0);
CASE ilk[p] OF
0:
BEGIN
tokmem[tokptr]:=10240+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
3:
BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
6:
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
7:
BEGIN
tokmem[tokptr]:=131;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
8:
BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=8;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
11:
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
12:
BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
15:
BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
22:
BEGIN
tokmem[tokptr]:=141;tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=13;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
19:
BEGIN
tokmem[tokptr]:=132;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
{157}
4:
BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=5;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=0;
END;
END;
5:
BEGIN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=21;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
END;
9:
BEGIN
{158}
IF(scrapptr<scrapbase)OR((cat[scrapptr]<>10)
AND(cat[scrapptr]<>9))THEN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=10;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=20;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
END;
10:
BEGIN
{158}
IF(scrapptr<scrapbase)OR((cat[scrapptr]<>10)
AND(cat[scrapptr]<>9))THEN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=10;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=6;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
END;
13:
BEGIN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=12;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
END;
16:
BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=16;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
BEGIN tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
END;
17:
BEGIN
BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=18;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=0;
END;
END;
18:
BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=5;
irans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=0;
END;
END;
20:
BEGIN
{158}
IF(scrapptr<scrapbase)OR((cat[scrapptr]<>10)
AND(cat[scrapptr]<>9))THEN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=10;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=6;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=13;
trans[scrapptr]:=0;
END;
END;
21:
BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=19;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=0;
END;
END;
OTHERS:
BEGIN
nextcontrol:=ilk[p]-23;
GOTO 21;
END
END;
END;
128:
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=69;
tokptr:=tokptr+1;
tokmem[tokptr]:=123;
tokptr:=tokptr+1;scrapptr:=scrapptr+1;
cat[scrapptr]:=15;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
9:
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=66;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
10:
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=84;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
12:
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=79;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
134:
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=44;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
133:
{155}
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=104;
tokptr:=tokptr+1;
tokmem[tokptr]:=98;
tokptr:=tokptr+1;
tokmem[tokptr]:=111;
tokptr:=tokptr+1;
tokmem[tokptr]:=120;
tokptr:=tokptr+1;
tokmem[tokptr]:=123;
tokptr:=tokptr+1;
FOR j:=idfirst TO idloc-1 DO
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
END;
Error;
Quit;
END;
tokmem[tokptr]:=buffer[j];
tokptr:=tokptr+1;
END;
BEGIN
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
END;
135:
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Appcomment;
END;
136:
BEGIN
tokmem[tokptr]:=142;
tokptr:=tokptr+1;
Appcomment;
END;
137:
BEGIN
tokmem[tokptr]:=134;
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
BEGIN
tokmem[tokptr]:=134;
tokptr:=tokptr+1;
Appcomment;
END;
END;
138:
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=9;
trans[scrapptr]:=0;
END;
127:
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=74;
tokpt:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
OTHERS:
BEGIN
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END
END;
nextcontrol:=Getnext;
IF(nextcontrol=124)OR(nextcontrol=123)THEN GOTO 10;
END;
10:
END;
{160}
FUNCTION Pascaltransl:textpointer;
VAR
p:textpointer;
savebase:0..maxscraps;
BEGIN
savebase:=scrapbase;
scrapbase:=scrapptr+1;
Pascalparse;
IF nextcontrol<>124 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Missing "|" after PASCAL text');
END;
Error;
END;
END;
BEGIN IF tokptr+2>maxtoks THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
END;
Error;
Quit;
END;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
END;
Appcomment;
p:=Translate;
IF scrapptr>maxscrptr THEN maxscrptr:=scrapptr;
scrapptr:=scrapbase-1;
scrapbase:=savebase;
Pascaltransl:=p;
END;
{161}
PROCEDURE Outerparse;
VAR
bal:eightbits;
p,q:textpointer;
BEGIN
WHILE nextcontrol<139 DO
IF nextcontrol<>123 THEN Pascalparse
ELSE
BEGIN
IF(tokptr+7>maxtoks)OR(textptr+3>maxtexts)
OR(scrapptr>=maxscraps)THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token/scrap',' capacity exceeded');
END;
Error;
Quit;
END;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=67;
tokptr:=tokptr+1;
tokmem[tokptr]:=123;
tokptr:=tokptr+1;
bal:=Copycomment(1);
nextcontrol:=124;
WHILE bal>0 DO
BEGIN
p:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
q:=Pascaltransl;
tokmem[tokptr]:=40960+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=51200+q;
tokptr:=tokptr+1;
IF nextcontrol=124 THEN bal:=Copycomment(bal)
ELSE bal:=0;
END;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Appcomment;
END;
END;
{166}
PROCEDURE Pushlevel(p:textpointer);
BEGIN
IF stackptr=stacksize THEN
BEGIN
BEGIN
Writeln(tty);Write(tty,'! Sorry, ','stack',' capacity exceeded');
END;
Error;
Quit;
END
ELSE
BEGIN
IF stackptr>0 THEN
stack[stackptr]:=curstate;
stackptr:=stackptr+1;
IF stackptr>maxstackptr THEN maxstackptr:=stackptr;
curstate.tokfield:=tokstart[p];
curstate.endfield:=tokstart[p+1];
END;
END;
{168}
FUNCTION Getoutput:eightbits;
LABEL 20;
VAR a:sixteenbits;
BEGIN
20:WHILE curstate.tokfield=curstate.endfield DO
BEGIN
stackptr:=stackptr-1;
curstate:=stack[stackptr];
END;
a:=tokmem[curstate.tokfield];
curstate.tokfield:=curstate.tokfield+1;
IF a>=256 THEN
BEGIN
curname:=a MOD 10240;
CASE a DIV 10240 OF
2:a:=129;
3:a:=128;
4:
BEGIN
Pushlevel(curname);
GOTO 20;
END;
5:
BEGIN
Pushlevel(curname);
curstate.modefield:=inner;
GOTO 20;
END;
OTHERS:a:=130
END;
END;
{IF TROUBLESHOOT THEN DEBUGHELP;}
Getoutput:=a;
END;
{169}
PROCEDURE Makeoutput;
FORWARD;
PROCEDURE Outputpascal;
VAR
savetokptr,savetextptr,savenextcont:sixteenbits;
p:textpointer;
BEGIN
savetokptr:=tokptr;
savetextptr:=textptr;
savenextcont:=nextcontrol;
nextcontrol:=124;
p:=Pascaltransl;
tokmem[tokptr]:=p+51200;
tokptr:=tokptr+1;
tokmem[tokptr]:=143;
tokptr:=tokptr+1;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
Pushlevel(textptr-1);
Makeoutput;
IF textptr>maxtxtptr THEN maxtxtptr:=textptr;
IF tokptr>maxtokptr THEN maxtokptr:=tokptr;
textptr:=savetextptr;
tokptr:=savetokptr;
nextcontrol:=savenextcont;
END;
{170}
PROCEDURE Makeoutput;
LABEL 21,10,31;
VAR
a:eightbits;
b:eightbits;
k,klimit:0..maxbytes;
j:0..longbufsize;
stringdelimi:asciicode;
saveloc,savelimit:0..longbufsize;
BEGIN WHILE true DO
BEGIN
a:=Getoutput;
21:CASE a OF
143:GOTO 10;
130,129:
{171}
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
IF a=130 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END
ELSE
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=38;
END;
IF bytestart[curname+1]=bytestart[curname]+1 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=bytemem[bytestart[curname]];
END
ELSE Outname(curname);
END;
128:
{175}
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=88;
END;
IF xmem[xref[curname]].numfield>=10240 THEN
Outval(xmem[xref[curname]].numfield-10240)
ELSE
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=48;
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=58;
END;
{176}
k:=bytestart[curname];
klimit:=bytestart[curname+1];
WHILE k<klimit DO
BEGIN
b:=bytemem[k];
k:=k+1;
IF b=64 THEN
{177}
BEGIN
IF bytemem[k]<>64 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Illegal control code in module name:');
END;
BEGIN Writeln(tty);
Write(tty,'<');
END;
Printid(curname);
Write(tty,'> ');
END;
k:=k+1;
END;
IF b<>124 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=b;
END
ELSE BEGIN{178}j:=limit+1;
buffer[j]:=124;
stringdelimi:=0;
WHILE true DO
BEGIN
IF k=klimit THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! PASCAL text in module name didn''t end:');
END;
BEGIN Writeln(tty);
Write(tty,'<');
END;
Printid(curname);
Write(tty,'> ');
GOTO 31;
END;
b:=bytemem[k];
k:=k+1;
IF(b=34)OR(b=39)THEN
IF stringdelimi=0 THEN stringdelimi:=b
ELSE IF stringdelimi=b THEN stringdelimi:=0;
IF(b<>124)OR (stringdelimi<>0)THEN
BEGIN
IF j>longbufsize-3 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','buffer',' capacity exceeded');
END;
Error;
Quit;
END;
j:=j+1;
buffer[j]:=b;
END
ELSE GOTO 31;
END;
31:;
saveloc:=loc;
savelimit:=limit;
loc:=limit+2;
limit:=j+1;
buffer[limit]:=124;
Outputpascal;
loc:=saveloc;
limit:=savelimit;
END;
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=88;
END;
END;
131,133,132:
{172}
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=109;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=97;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=116;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=104;
END;
IF a=131 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=98;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=105;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
END
ELSE IF a=132 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=114;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=101;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=108;
END
ELSE
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=111;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=112;
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=123;
END;
END;
135:
BEGIN
REPEAT a:=Getoutput;
UNTIL(a<139)OR(a>142);
GOTO 21;
END;
134:
BEGIN
REPEAT a:=Getoutput;
UNTIL((a<139)AND(a<>32))OR(a>142);
GOTO 21;
END;
136,137,138,139,140,141,142:
{173}
IF a<140 THEN
BEGIN
IF curstate.modefield=outer THEN
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=a-87;
END;
IF a=138 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=Getoutput;
END
END
ELSE IF a=138 THEN b:=Getoutput
END
ELSE
{174}
BEGIN
b:=a;
WHILE true DO
BEGIN
a:=Getoutput;
IF(a=135)OR(a=134) THEN GOTO 21;
IF((a<>32)AND(a<140))OR(a>142)THEN
BEGIN
IF curstate.modefield=outer THEN
BEGIN
IF outptr>3 THEN
IF(outbuf[outptr]=80)AND(outbuf[outptr-1]=92)
AND(outbuf[outptr-2]=89)AND(outbuf[outptr-3]=92)THEN GOTO 21;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=b-87;
END;
IF a<>143 THEN
BEGIN
IF(outptr>0)OR(limit=0)THEN Flushbuffer(outptr);
END;
END
ELSE IF a<>143 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
END;
GOTO 21;
END;
IF a>b THEN b:=a;
END;
END;
OTHERS:
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=a;
END
END;
END;
10:
END;
{185}
PROCEDURE Finishpascal;
VAR p:textpointer;
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=80;
END;
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
END;
Error;
Quit;
END;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
END;
Appcomment;
p:=Translate;
tokmem[tokptr]:=p+40960;
tokptr:=tokptr+1;
tokmem[tokptr]:=143;
tokptr:=tokptr+1;
BEGIN
dtextptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
Pushlevel(textptr-1);
Makeoutput;
IF outptr>1 THEN
IF outbuf[outptr-1]=92 THEN
IF outbuf[outptr]=54 THEN outptr:=outptr-2
ELSE IF outbuf[outptr]=55 THEN outbuf[outptr]:=89;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=112;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=97;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=114;
END;
BEGIN
IF(outptr>0)OR(limit=0)THEN Flushbuffer(outptr);
END;
IF textptr>maxtxtptr THEN maxtxtptr:=textptr;
IF tokptr>maxtokptr THEN maxtokptr:=tokptr;
IF scrapptr>maxscrptr THEN maxscrptr:=scrapptr;
tokptr:=1;
textptr:=1;
scrapptr:=0;
END;
{193}
PROCEDURE Footnote(flag:sixteenbits);
LABEL 30;
VAR p,q,r:0..maxrefs;
BEGIN
BEGIN
IF(outptr>0)OR(limit=0)THEN Flushbuffer(outptr);
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
IF flag=0 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=85;
END
ELSE
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=65;
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=115;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=101;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=99;
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=116;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=105;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=111;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
END;
{194}
q:=0;
p:=curxref;
REPEAT
r:=xmem[p].xlinkfield;
xmem[p].xlinkfield:=q;
q:=p;
p:=r;
UNTIL xmem[p].numfield<=flag;
xmem[curxref].xlinkfield:=p;
;
{195}
p:=q;
IF p<>curxref THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=115;
END;
WHILE true DO
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
END;
Outval(xmem[p].numfield-flag);
IF p=curxref THEN GOTO 30;
p:=xmem[p].xlinkfield;
IF(p<>curxref)OR(p<>xmem[q].xlinkfield)THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=44;
END;
IF p=curxref THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=97;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=100;
END;
END;
30:;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=46;
END;
END;
{203}
PROCEDURE Unbucket(d:eightbits);
VAR c:asciicode;
BEGIN FOR c:=101 DOWNTO 0 DO
IF bucket[collate[c]]>0 THEN
BEGIN
IF scrapptr>maxscraps THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','sorting',' capacity exceeded');
END;
Error;
Quit;
END;
scrapptr:=scrapptr+1;
IF scrapptr>maxsortptr THEN maxsortptr:=scrapptr;
IF c=0 THEN cat[scrapptr]:=255
ELSE cat[scrapptr]:=d;
trans[scrapptr]:=bucket[collate[c]];
bucket[collate[c]]:=0;
END;
END;
{213}
PROCEDURE DEBUGHELP;
LABEL 888,10;
VAR K:SIXTEENBITS;
BEGIN
DEBUGSKIPPED:=DEBUGSKIPPED+1;
IF DEBUGSKIPPED<DEBUGCYCLE THEN GOTO 10;
DEBUGSKIPPED:=0;
888:
['*****************************breakpoint*****************************']
WHILE TRUE DO
BEGIN
WRITE(TTY,'#');
READ(TTY,DDT);
IF DDT<0 THEN GOTO 10
ELSE IF DDT=0 THEN GOTO 888;
READ(TTY,DD);
CASE DDT OF
1:PRINTID(DD);
2:PRINTTEXT(DD);
3:FOR K:=1 TO DD DO WRITE(TTY,CHR(BUFFER[K]));
4:FOR K:=1 TO DD DO WRITE(TTY,CHR(MODULE[K]));
5:FOR K:=1 TO OUTPTR DO WRITE(TTY,CHR(OUTBUF[K]));
6:FOR K:=1 TO DD DO BEGIN PRINTCAT(CAT[K]);
WRITE(TTY,' ');
END;
OTHERS:WRITE(TTY,'?')
END;
END;
10:END;
{214}
BEGIN
Initialize;
{46}
idloc:=10;
idfirst:=7;
buffer[7]:=97;
buffer[8]:=110;
buffer[9]:=100;
curname:=Idlookup(27);
idfirst:=5;
buffer[5]:=97;
buffer[6]:=114;
buffer[7]:=114;
buffer[8]:=97;
buffer[9]:=121;
curname:=Idlookup(3);
idfirst:=5;
buffer[5]:=98;
buffer[6]:=101;
buffer[7]:=103;
buffer[8]:=105;
buffer[9]:=110;
curname:=Idlookup(4);
idfirst:=6;
buffer[6]:=99;
buffer[7]:=97;
buffer[8]:=115;
buffer[9]:=101;
curname:=Idlookup(5);
idfirst:=5;
buffer[5]:=99;
buffer[6]:=111;
buffer[7]:=110;
buffer[8]:=115;
buffer[9]:=116;
curname:=Idlookup(6);
idfirst:=7;
buffer[7]:=100;
buffer[8]:=105;
buffer[9]:=118;
curname:=Idlookup(7);
idfirst:=8;
buffer[8]:=100;
buffer[9]:=111;
curname:=Idlookup(8);
idfirst:=4;
buffer[4]:=100;
buffer[5]:=111;
buffer[6]:=119;
buffer[7]:=110;
buffer[8]:=116;
buffer[9]:=111;
curname:=Idlookup(19);
idfirst:=6;
buffer[6]:=101;
buffer[7]:=108;
buffer[8]:=115;
buffer[9]:=101;
curname:=Idlookup(9);
idfirst:=7;
buffer[7]:=101;
buffer[8]:=110;
buffer[9]:=100;
curname:=Idlookup(10);
idfirst:=6;
buffer[6]:=102;
buffer[7]:=105;
buffer[8]:=108;
buffer[9]:=101;
curname:=Idlookup(3);
idfirst:=7;
buffer[7]:=102;
buffer[8]:=111;
buffer[9]:=114;
curname:=Idlookup(11);
idfirst:=2;
buffer[2]:=102;
buffer[3]:=117;
buffer[4]:=110;
buffer[5]:=99;
buffer[6]:=116;
buffer[7]:=105;
buffer[8]:=111;
buffer[9]:=110;
curname:=Idlookup(16);
idfirst:=6;
buffer[6]:=103;
buffer[7]:=111;
buffer[8]:=116;
buffer[9]:=111;
curname:=Idlookup(12);
idfirst:=8;
buffer[8]:=105;
buffer[9]:=102;
curname:=Idlookup(13);
idfirst:=8;
buffer[8]:=105;
buffer[9]:=110;
curname:=Idlookup(29);
idfirst:=5;
buffer[5]:=108;
buffer[6]:=97;
buffer[7]:=98;
buffer[8]:=101;
buffer[9]:=108;
curname:=Idlookup(6);
idfirst:=7;
buffer[7]:=109;
buffer[8]:=111;
buffer[9]:=100;
curname:=Idlookup(7);
idfirst:=7;
buffer[7]:=110;
buffer[8]:=105;
buffer[9]:=108;
curname:=Idlookup(15);
idfirst:=7;
buffer[7]:=110;
buffer[8]:=111;
buffer[9]:=116;
curname:=Idlookup(28);
idfirst:=8;
buffer[8]:=111;
buffer[9]:=102;
curname:=Idlookup(8);
idfirst:=8;
buffer[8]:=111;
buffer[9]:=114;
curname:=Idlookup(54);
idfirst:=4;
buffer[4]:=112;
buffer[5]:=97;
buffer[6]:=99;
buffer[7]:=107;
buffer[8]:=101;
buffer[9]:=100;
curname:=Idlookup(12);
idfirst:=1;
buffer[1]:=112;
buffer[2]:=114;
buffer[3]:=111;
buffer[4]:=99;
buffer[5]:=101;
buffer[6]:=100;
buffer[7]:=117;
buffer[8]:=114;
buffer[9]:=101;
curname:=Idlookup(16);
idfirst:=3;
buffer[3]:=112;
buffer[4]:=114;
buffer[5]:=111;
buffer[6]:=103;
buffer[7]:=114;
buffer[8]:=97;
buffer[9]:=109;
curname:=Idlookup(16);
idfirst:=4;
buffer[4]:=114;
buffer[5]:=101;
buffer[6]:=99;
buffer[7]:=111;
buffer[8]:=114;
buffer[9]:=100;
curname:=Idlookup(17);
idfirst:=4;
buffer[4]:=114;
buffer[5]:=101;
buffer[6]:=112;
buffer[7]:=101;
buffer[8]:=97;
buffer[9]:=116;
curname:=Idlookup(18);
idfirst:=7;
buffer[7]:=115;
buffer[8]:=101;
buffer[9]:=116;
curname:=Idlookup(3);
idfirst:=6;
buffer[6]:=116;
buffer[7]:=104;
buffer[8]:=101;
buffer[9]:=110;
curname:=Idlookup(8);
idfirst:=8;
buffer[8]:=116;
buffer[9]:=111;
curname:=Idlookup(19);
idfirst:=6;
buffer[6]:=116;
buffer[7]:=121;
buffer[8]:=112;
buffer[9]:=101;
curname:=Idlookup(6);
idfirst:=5;
buffer[5]:=117;
buffer[6]:=110;
buffer[7]:=116;
buffer[8]:=105;
buffer[9]:=108;
curname:=Idlookup(20);
idfirst:=7;
buffer[7]:=118;
buffer[8]:=97;
buffer[9]:=114;
curname:=Idlookup(21);
idfirst:=5;
buffer[5]:=119;
buffer[6]:=104;
buffer[7]:=105;
buffer[8]:=108;
buffer[9]:=101;
curname:=Idlookup(11);
idfirst:=6;
buffer[6]:=119;
buffer[7]:=105;
buffer[8]:=116;
buffer[9]:=104;
curname:=Idlookup(11);
idfirst:=3;
buffer[3]:=120;
buffer[4]:=99;
buffer[5]:=108;
buffer[6]:=97;
buffer[7]:=117;
buffer[8]:=115;
buffer[9]:=101;
curname:=Idlookup(22);
;
{79}
phaseone:=true;
Resetinput;
modulecount:=0;
REPEAT
Skiplimbo;
IF NOT inputhasende THEN
REPEAT
{80}
IF modulecount<10239 THEN
modulecount:=modulecount+1
ELSE
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','module number',' capacity exceeded');
END;
Error;
Quit;
END;
{83}
REPEAT
nextcontrol:=Skiptex;
CASE nextcontrol OF
126:xrefswitch:=10240;
125:xrefswitch:=0;
124:Pascalxref;
131,132,142:BEGIN loc:=loc-2;
nextcontrol:=Getnext;
IF nextcontrol<>142 THEN Newxref(Idlookup(nextcontrol-130));
END;
OTHERS:END;
UNTIL nextcontrol>=139;
{85}
whilenextcontrol<=140 DO
BEGIN
xrefswitch:=10240;
IF nextcontrol=140 THEN nextcontrol:=Getnext
ELSE
{86}
BEGIN
nextcontrol:=Getnext;
IF nextcontrol=130 THEN
BEGIN
lhs:=Idlookup(0);
ilk[lhs]:=0;
Newxref(lhs);
nextcontrol:=Getnext;
IF nextcontrol=30 THEN
BEGIN
nextcontrol:=Getnext;
IF nextcontrol=130 THEN
BEGIN
rhs:=Idlookup(0);
ilk[lhs]:=ilk[rhs];
ilk[rhs]:=0;
Newxref(rhs);
ilk[rhs]:=ilk[lhs];
nextcontrol:=Getnext;
END;
END;
END;
END;
Outerxref;
END;
{87}
IF nextcontrol<=142 THEN
BEGIN
IF nextcontrol=141 THEN
modxrefswitc:=0
ELSE modxrefswitc:=10240;
REPEAT
IF nextcontrol=142 THEN Newmodxref(curmodule);
nextcontrol:=Getnext;
Outerxref;
UNTIL nextcontrol>142;
END;
UNTIL nextcontrol=143;
UNTIL inputhasende;
phaseone:=false;
{90}
Modcheck(ilk[0]);
;
{179}
Resetinput;
BEGIN
Writeln(tty);
Write(tty,
'Writing the output file...');
END;
modulecount:=0;
REPEAT
Copylimbo;
IF NOT inputhasende THEN
BEGIN
REPEAT
{181}
modulecount:=modulecount+1;
{182}
BEGIN
IF(outptr>0)OR(limit=0)THEN Flushbuffer(outptr);
END;
Flushbuffer(0);
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
IF buffer[loc-1]=42 THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=78;
END
ELSE
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=77;
END;
Outval(modulecount);
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=46;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
END;
saveline:=outline;
saveplace:=outptr;
{183}
REPEAT
nextcontrol:=Copytex;
CASE nextcontrol OF
124:
BEGIN
stackptr:=0;
curstate.modefield:=outer;
Outputpascal;
END;
131,132,142:
BEGIN
loc:=loc-2;
nextcontrol:=Getnext;
END;
OTHERS:
END;
UNTIL nextcontrol>=139;
{184}
IF nextcontrol<=140 THEN
BEGIN
IF(saveline<>outline)OR(saveplace<>outptr)THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=89;
END;
saveline:=outline;
saveplace:=outptr;
END;
WHILE nextcontrol<=140 DO
BEGIN
stackptr:=0;
curstate.modefield:=outer;
IF nextcontrol=140 THEN
{186}
BEGIN
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=68;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
nextcontrol:=Getnext;
IF nextcontrol<>130 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Improper macro definition');
END;
Error;
END;
END
ELSE
BEGIN
tokmem[tokptr]:=10240+Idlookup(0);
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
nextcontrol:=Getnext;
END
ELSE
{187}
BEGIN
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=70;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
nextcontrol:=Getnext;
IF nextcontrol=130 THEN
BEGIN
BEGIN
tokmem[tokptr]:=10240+Idlookup(0);
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
nextcontrol:=Getnext;
IF nextcontrol=30 THEN
BEGIN
BEGIN
tokmem[tokptr]:=30;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
nextcontrol:=Getnext;
IF nextcontrol=130 THEN
BEGIN
BEGIN
tokmem[tokptr]:=10240+Idlookup(0);
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[
scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
BEGIN scrapptr:=scrapptr+1;
cat[scrapptr]:=9;
trans[scrapptr]:=0;
END;
nextcontrol:=Getnext;
END;
END;
END;
IF scrapptr<>5
THEN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Improper format definition');
END;
Error;
END;
END;
END;
Outerparse;
Finishpascal;
END;
{189}
thismodule:=0;
IF nextcontrol<=142 THEN
BEGIN
IF(saveline<>outline)OR(saveplace<>outptr)THEN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=89;
END;
stackptr:=0;
curstate.modefield:=outer;
IF nextcontrol=141 THEN nextcontrol:=Getnext
ELSE
BEGIN
thismodule:=curmodule;
{190}
REPEAT nextcontrol:=Getnext;
UNTIL nextcontrol<>43;
IF(nextcontrol<>61)AND(nextcontrol<>30)THEN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! You need an = sign after the module name');
END;
Error;
END;
END
ELSE
nextcontrol:=Getnext;
IF outptr>1 THEN
IF(outbuf[outptr]=89)AND(outbuf[outptr-1]=92)THEN
BEGIN
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
END;
BEGIN
tokmem[tokptr]:=30720+thismodule;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=22;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
curxref:=xref[thismodule];
IF xmem[curxref].numfield<>modulecount+10240 THEN
BEGIN
BEGIN
tokmem[tokptr]:=132;
tokptr:=tokptr+1;
tokmem[tokptr]:=43;
tokptr:=tokptr+1;
tokmem[tokptr]:=126;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
thismodule:=0;
END;
BEGIN
tokmem[tokptr]:=30;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=9;
trans[scrapptr]:=textptr;
BEGIN textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
;
END;
WHILE nextcontrol<=142 DO
BEGIN
Outerparse;
{191}
IF nextcontrol<142 THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! You can''t do that in PASCAL text');
END;
Error;
END;
END;
nextcontrol:=Getnext;
END
ELSE IF nextcontrol=142 THEN
BEGIN
BEGIN
tokmem[tokptr]:=30720+curmodule;
tokptr:=tokptr+1;
scrapptr:=
scrapptr+1;
cat[scrapptr]:=22;
trans[scrapptr]:=textptr;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
nextcontrol:=Getnext;
END;
END;
Finishpascal;
END;
{192}
IF thismodule>0 THEN
BEGIN
curxref:=xmem[curxref].xlinkfield;
IF xmem[curxref].numfield>=10240 THEN
BEGIN
Footnote(10240);
curxref:=xmem[curxref].xlinkfield;
END;
IF curxref<>0 THEN Footnote(0);
END;
;
UNTIL nextcontrol=143;
IF NOT inputhasende THEN Writeendofpa;
END;
UNTIL
inputhasende;
;
{196}
buffer[0]:=32;
BEGIN
Writeln(tty);
Write(tty,'Writing the index...');
END;
BEGIN
IF(outptr>0)OR(limit=0)THEN
Flushbuffer(outptr);
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=105;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=120;
END;
BEGIN
IF(outptr>0)OR(limit=0)THEN
Flushbuffer(outptr);
END;
{198}
FOR c:=0 TO 127 DO bucket[c]:=0;
FOR h:=0 TO hashsize-1 DO
BEGIN
nextname:=hash[h];
WHILE nextname<>0 DO
BEGIN
curname:=nextname;
nextname:=link[curname];
IF xref[curname]<>0 THEN
BEGIN
c:=bytemem[bytestart[curname]];
IF(c<=90)AND(c>=65)THEN c:=c+32;
link[curname]:=bucket[c];
bucket[c]:=curname;
END;
END;
END;
{204}
scrapptr:=0;
Unbucket(1);
WHILE scrapptr>0 DO
BEGIN
curdepth:=cat[scrapptr];
IF(link[trans[scrapptr]]=0)OR(curdepth=255)THEN
{206}
BEGIN
curname:=trans[scrapptr];
{IF TROUBLESHOOT THEN DEBUGHELP;}
REPEAT
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=43;
END;
{207}
CASE ilk[curname] OF
0:
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[
outptr]:=92;
END;
1:;
2:
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=46;
END;
OTHERS:
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=38;
END
END;
Outname(curname);
;
{208}{210}
thisxref:=xref[curname];
curxref:=0;
REPEAT
nextxref:=xmem[thisxref].xlinkfield;
xmem[thisxref].xlinkfield:=curxref;
curxref:=thisxref;
thisxref:=nextxref;
UNTIL thisxref=0;
REPEAT
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=44;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
END;
curval:=xmem[curxref].numfield;
IF curval<10240 THEN Outval(curval)
ELSE
BEGIN
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=91;
END;
Outval(curval-10240);
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=93;
END;
END;
curxref:=xmem[curxref].xlinkfield;
UNTIL curxref=0;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=46;
END;
BEGIN
IF(outptr>0)OR(limit=0) THEN Flushbuffer(outptr);
END;
;
curname:=link[curname];
UNTIL curname=0;
scrapptr:=scrapptr-1;
END
ELSE{205}
BEGIN
nextname:=trans[scrapptr];
REPEAT
curname:=nextname;
nextname:=link[curname];
curbyte:=bytestart[curname]+curdepth;
IF curbyte=bytestart[curname+1]THEN c:=0
ELSE
BEGIN
c:=bytemem[curbyte];
IF(c<=90)AND(c>=65)THEN c:=c+32;
END;
link[curname]:=bucket[c];
bucket[c]:=curname;
UNTIL nextname=0;
scrapptr:=scrapptr-1;
Unbucket(curdepth+1);
END;
END;
BEGIN
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=102;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=105;
IF outptr=linelength THEN Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
END;
BEGIN
IF(outptr>0)OR(limit=0)THEN Flushbuffer(outptr);
END;
Write(tty,'Done.');
;
9999:
{215}
BEGIN
Writeln(tty);
Write(tty,'Memory usage statistics: ',nameptr:0,' names, ',xrefptr:0,
' cross references;');
END;
BEGIN Writeln(tty);
Write(tty,'parsing required ',maxscrptr:0,
' scraps, ',maxtxtptr:0,' texts, ',
maxtokptr:0,' tokens, ',maxstackptr:0,' levels;');
END;
BEGIN
Writeln(tty);
Write(tty,'sorting required ',maxsortptr:0,' levels.');
END;
END.